Otherware/Otherware_1_SB_Development.iso/mac/hypercar/xfcn/spttool.cpt/Support Tools eXternals 1.2.5/card_5393.txt

Text File | 1990-11-13 | 27KB | 723 lines

-- card: 5393 from stack: in.5
-- bmap block id: 5817
-- flags: 0000
-- background id: 3858
-- name: FolderPath
----- HyperTalk script -----
on HideObjects
  hide cd btn "Try It!"
end HideObjects

on ShowObjects
  show cd btn "Try It!"
end ShowObjects


-- part 3 (button)
-- low flags: 00
-- high flags: A002
-- rect: left=82 top=185 right=219 bottom=175
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 8192
-- line height: 16
-- part name: Try it!
----- HyperTalk script -----
on mouseUp
  global errGlobal
  put FolderPath("Choose a folder please.") into thePath
  if thePath = empty then exit mouseUp
  if errGlobal Γëá empty then
    answer "Error: ΓÇ£" & errGlobal & "ΓÇ¥"
    put empty into errGlobal
  else
    answer "You chose ΓÇ£" & thePath & "ΓÇ¥"
  end if
end mouseUp




-- part contents for background part 20
----- text -----
     FolderPath displays a modified Standard File dialog to let the user choose a folder.  It returns the full path name of the chosen folder, or empty if the CANCEL button is chosen.

     In addition to the standard Eject, Drive, Select, and Cancel buttons, the XFCN displays the amount of free space on a volume.  Additionally you may supply a prompt string (in parameter two) which will be placed below the file list.  If called without any parmeters, ie. FolderName(), the default prompt will be used (Highlight a directory and press "Select").

      As with all of our XCMDs and XFCNs, passing a single question mark (FolderName("?") in this case) returns the syntax for the external.  Passing an exclamation point (FolderName("!")) returns the copyright information.

-- part contents for background part 38
----- text -----
23/50

-- part contents for background part 42
----- text -----
{ FolderName() XFCN source listing}
{ This is an XFCN that brings up a custom standard file dialog to allow the user to select a folder.}
{ This source file is part of a stack containing all necessary source code and compiled versions of}
{}
{  Written by:  Anup Murarka    Eric Carlson    }
{        ALINK:  SKEPTIC    ALINK:  cyNic  }
{                  CIS:  76004,3356    }
{}
{        We are part of the Support Tools Development Group,  }
{        Apple Computer, Inc.  }
{}
{        please DO NOT contack Mac DTS for support of this code!  }
{}
{        please DO contact the authors for support of this code!  }
{}
{        Send comments, bug reports, requests to any of the above  }
{        E-mail addresses or to:}
{}
{              (one of us)          }
{              Apple Computer, Inc.    }
{              900 E. Hamilton, Ave.    }
{              Campbell, CA   95008    }
{              M/S 72-L          }
{}
{  Copyright:  © 1989, 1990 by Apple Computer, Inc., all rights reserved.  }
{}
{ written by  : Anup Murarka                                        }
{ AppleLink  : Skeptic                                            }
{ modification history                                             }
{       Date      Initials                  Comments                }
{       ----      ------    ------------------------------------------------------}
{    11/29/89  ec&akm    first written                              }
{    8/14/90        ec      recompiled with new libraries for Modal Dialog update  bug  }
{                      & A/UX correct path construction. Changed version to 1.1  }
{}
unit dummyUnit;

interface

  uses
    HyperXCMD;

  procedure main (paramPtr: XCmdPtr);

implementation

  procedure FolderName (paramPtr: XCmdPtr);
  FORWARD;

  procedure main (paramPtr: XCmdPtr);
  begin
    FolderName(paramPtr);
  end;

  const
    kSFSaveDisk = $214;        { Negative of current volume refnum [WORD]  }
    kApplScratch = $00000A78;
    kCurDirStore = $398;        { DirID of current directory [LONG]        }
    DITLSizeDiff = 30;

  type
    DITLItem = record
        itmHndl: handle;
        itmRect: rect;
        itmType: SignedByte;
        itmData: SignedByte;     { This is really only the length byte.  Data follows of variable length}
{    itmData is followed by the actual data.  See IM I-427}
      end;
    pDITLItem = ^DITLItem;
    hDITLItem = ^pDITLItem;

    ItemList = record
        dlgMaxIndex: integer;
        DITLItems: array[0..0] of DITLItem;
      end;
    pItemList = ^ItemList;
    hItemList = ^pItemList;

    integerPtr = ^integer;

  procedure reportToUser (paramPtr: XCmdPtr;
                  msgStr: str255);
{}
{ report something back to the user.  }
{ the last parameter (optional) to an external may contain }
 { "noDialog" or "noDialog:GlobalName".  GlobalName is the name }
 { of a HyperTalk global variable into which error messages will be }
 { placed.  we've decided to use this approach to avoid confusing }
{ an error message with a valid result being returned from an XFCN. }
{}
    var
      tempStr: str255;
  begin
{check the last param to see if the user requested that}
{ we suppress the error dialog }
    ZeroToPas(paramPtr, paramPtr^.params[paramPtr^.paramCount]^, tempStr);
    UprString(tempStr, true);
    if pos('NODIALOG', tempStr) = 0 then
  { no special error handling specified, throw up a dialog and return the error message }
      begin
        SendCardMessage(paramPtr, concat('answer "', msgStr, '"'));
        paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
      end
    else if (pos(':', tempStr) > 0) then
  { requested global AND noDialog so we fill in the global and return empty }
      begin
        tempStr := copy(tempStr, pos(':', tempStr) + 1, length(tempStr));
                            { get the name of the HC global  to fill }
        SetGlobal(paramPtr, tempStr, PasToZero(paramPtr, msgStr));
                            { and fill it }
        paramPtr^.returnValue := PasToZero(paramPtr, '');  { return empty }
      end
    else
  { requested noDialog only so we return the error condition as the result }
      paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
  end;  { procedure }

  function AskedForHelp (paramPtr: XCmdPtr;
                  syntaxMsg: Str255;
                  copyrightMsg: Str255): boolean;
{  check to see if the user sent a '?' or a '!' as }
{ the only parameter. if so we will respond with }
{ the calling syntax or the copyright/version info }
{ for this external }
{}
    var
      firstStr: str255;
  begin
    askedForHelp := false;
    if paramPtr^.paramCount = 1 then
      begin
        ZeroToPas(paramPtr, paramPtr^.params[1]^, firstStr);
          { what is the first param? }
        if firstStr = '?' then
          begin
            reportToUser(paramPtr, syntaxMsg);
            askedForHelp := true
          end  { asked for help }
        else if firstStr = '!' then
          begin
            reportToUser(paramPtr, copyRightMsg);
            askedForHelp := true
          end;  { asked for copyright info }
      end;  { one parameter passed }
  end;  { function }

  function PathNameFromDirID (dirID: longint;
                  vRefnum: integer;
                  var fullPathName: str255): OSErr;
{ build up a full path name given a directory id and an vol ref num.  this method isn't reccomended in general (see the }
{  various tech notes), but we use it in HC externals as HC uses exclusively full path names }
    var
      myCPB: CInfoPBRec;
      directoryName: str255;
      err: OSErr;
  begin
    fullPathName := '';
    with myCPB do
      begin
        ioNamePtr := @directoryName;
        ioDrParID := DirId;
      end;

    repeat
      with myCPB do
        begin
          ioVRefNum := vRefNum;
          ioFDirIndex := -1;
          ioDrDirID := myCPB.ioDrParID;
        end;
      err := PBGetCatInfo(@myCPB, FALSE);

      directoryName := concat(directoryName, ':');

{ pascal strings mustn't be longer than 255 chars, though a path name may, so check }
      if length(directoryName) + length(fullPathName) <= 255 then
        fullPathName := concat(directoryName, fullPathName)
      else
        myCPB.ioDrDirID := fsRtDirID;    { lazy persons way to jump out }

    until (myCPB.ioDrDirID = 2);
    PathNameFromDirID := err;
  end;

  function StrToRect (paramPtr: XCMDPtr;
                  rectStr: Str255): Rect;
{ convert a string, as from a callback or a passed parameter, to a rect }
    var
      where: Integer;
      tempRect: rect;
  begin
    where := POS(',', rectStr);
    tempRect.left := StrToNum(paramPtr, COPY(rectStr, 1, where - 1));
    DELETE(rectStr, 1, where);

    where := POS(',', rectStr);
    tempRect.top := StrToNum(paramPtr, COPY(rectStr, 1, where - 1));
    DELETE(rectStr, 1, where);

    where := POS(',', rectStr);
    tempRect.right := StrToNum(paramPtr, COPY(rectStr, 1, where - 1));
    DELETE(rectStr, 1, where);

    tempRect.bottom := StrToNum(ParamPtr, rectStr);

    strToRect := tempRect;
  end;

  function HCWindowRect (paramPtr: XCMDPtr): rect;
{ the rect of HC's card window, in GLOBAL coordinates }
    var
      theResult: Handle;
      rectStr: str255;
      theLength: INTEGER;
  begin
    rectStr := 'the rect of card window';
    theResult := EvalExpr(paramPtr, rectStr);
    if (theResult <> nil) and (paramPtr^.result = noErr) then
      ZeroToPas(paramPtr, theResult^, rectStr)
    else
      rectStr := '';
    if (theResult <> nil) then
      DisposHandle(theResult);
    HCWindowRect := StrToRect(paramPtr, rectStr);
  end;

  function GetScreenSize: rect;
  { we don't have access to quick draw globals, as they lie in HC's global space, but we can }
  { get the monitor size indirectly by checking the portBits field of the window manager port }
  { MacRevealed vol 3, pg 20 }
    var
      deskPort: GrafPtr;
      tempRect: rect;
  begin
    GetWMgrPort(deskPort);    { grab a pointer to the window manager port }
    if deskPort = nil then
      begin
        setRect(tempRect, 0, 0, 512, 342);
        GetScreenSize := tempRect;
      end
    else
      GetScreenSize := deskPort^.portBits.bounds;
  end;

  function monitorRect (aPoint: point): rect;
  { given a point, return the rect of the monitor that contains it.}
    const
      SysEnvVersion = 2;
    var
      currGDevice: GDHandle;
      gotTheMonitor: boolean;
      tempRect: rect;
      theSysEnv: SysEnvRec;
      envErr: OSErr;
  begin
    currGDevice := nil;
    envErr := SysEnvirons(SysEnvVersion, theSysEnv);
  {SysEnvirons Version is a constant in the interface section of this file}
    if theSysEnv.hasColorQD then    { only proceed if we have color QD }
      begin
        currGDevice := GetDeviceList;
        gotTheMonitor := false;    { haven't found the monitor yet }
        while (currGDevice <> nil) and not (gotTheMonitor) do
    { we assume that the point is in one of the graphic devices }
          begin
            if PtInRect(aPoint, currGDevice^^.gdRect) then
              begin
                monitorRect := currGDevice^^.gdRect;
                gotTheMonitor := true;
              end
            else    { get the next device in the list }
              currGDevice := currGDevice^^.gdNextGD;
          end;
        if currGDevice = nil then
          begin
            setRect(tempRect, 0, 0, 0, 0);
            monitorRect := tempRect;
          end;
      end
    else  {No Color QD}
      begin
        tempRect := GetScreenSize;
        if PtInRect(aPoint, tempRect) then
          monitorRect := tempRect
        else
          begin
            setRect(tempRect, 0, 0, 0, 0);
            monitorRect := tempRect;
          end;
      end;
  end;

  function CenterInHCWindow (paramPtr: XCMDPtr;
                  windowRect: rect): point;
    var
      where: point;
      window, screen, tempRect: rect;
      h, v: integer;
  begin
    window := HCWindowRect(paramPtr);    { the rect of card the window }
    screen := monitorRect(window.topLeft);
  { check to see the rect of the monitor containing the upper right corner of the card window }
    setRect(tempRect, 0, 0, 0, 0);
    if EqualRect(screen, tempRect) then
  { if '0,0,0,0' comes back then the upper right is off screen, check the upper left }
      begin
        setPt(where, window.right, window.top);
        screen := monitorRect(where);
      end;

    OffsetRect(windowRect, window.left - windowRect.left, window.top - windowRect.top);
  { zero the dlog rect onto the card window }
    h := ((window.right - window.left) - (windowRect.right - windowRect.left)) div 2;
    v := ((window.bottom - window.top) - (windowRect.bottom - windowRect.top)) div 2;
    OffSetRect(windowRect, h, v);

  { although it isn't possible to have BOTH upper corners off screen, check for an error. }
  { if we find one, use the default monitor rect }
    if EqualRect(screen, tempRect) then
      screen := GetScreenSize;

  { now center the rect in the card window }
    if not (PtInRect(windowRect.topLeft, screen) and PtInRect(windowRect.botRight, screen)) then
      begin    { make sure the dlog rect is fully visible on the screen }
        if windowRect.top < screen.top then
          OffSetRect(windowRect, 0, screen.top - windowRect.top + 10);
        if windowRect.bottom > screen.bottom then
          OffSetRect(windowRect, 0, screen.bottom - windowRect.bottom - 10);
        if windowRect.left < screen.left then
          OffSetRect(windowRect, screen.left - windowRect.left + 10, 0);
        if windowRect.right > screen.right then
          OffSetRect(windowRect, screen.right - windowRect.right - 10, 0);
      end;
    SetPt(where, windowRect.left, windowRect.top);
    CenterInHCWindow := where;
  end;

  function unSignedByte (SB: signedByte): integer;
    type
      twoSBAreAnInt = record
          case integer of
            0: (
                sbArray: array[0..1] of SignedByte
            );
            1: (
                Int: integer
            );
        end;
    var
      tempInt: twoSBAreAnInt;
  begin
    tempInt.Int := 0;
    tempInt.sbArray[1] := SB;
    unSignedByte := tempInt.int;
  end;

  function insertCommas (theNumber: str255): str255;
  { Procedure to insert commas every 3 numeric digits}
    var
      count, group: integer;
  begin
    group := 0;
    for count := length(theNumber) downto 1 do
      begin
        group := group + 1;
        if (group <> 3) or (count = 1) then
          cycle;
        insert(',', theNumber, count);
        group := 0;
      end;
    insertCommas := theNumber;
  end;

  procedure drawFreeSpace (theDialog: DialogPtr);
  { draw the amount of free space into the dialog, just above item #5, the eject button }
    var
      thePort: GrafPtr;
      oldFont, oldSize: integer;
      freeSpace: longint;
      freeStr: str255;
      PB: ParamBlockRec;
      strWidth: integer;
      volInfoErr: OSerr;
      eraseArea: rect;
      itemType, left: integer;
      itemHndl: handle;
      itemRect: rect;
  begin
    GetPort(thePort);
    if thePort <> nil then
      begin
        PB.iovRefNum := -(integerPtr(kSFSaveDisk)^);     { grab the VRefNum directly from lo mem}
        PB.ioVolIndex := 0;                         { use vRefNum only }
        PB.ioNamePtr := @freeStr;                   { VERY IMPORTANT!  Tell PBGetVInfo where to }
        volInfoErr := PBGetVInfo(@PB, false);           { put the vol name, even though we don't use it }

        if volInfoErr = noErr then
          begin
            FreeSpace := (PB.ioVAlBlkSiz * PB.ioVFrBlk) div 1024;       { Calc the free size}
            NumToString(FreeSpace, FreeStr);
            FreeStr := insertCommas(FreeStr);
          end
        else
          begin
            FreeStr := '????';         { If an error occured, show question marks}
          end;

        FreeStr := concat(FreeStr, 'k free');
        oldFont := thePort^.txFont;    { remember the old font }
        oldSize := thePort^.txSize;    { and the size }
        TextFont(3);            { set text to geneva }
        TextSize(9);            { 9 point }
        GetDItem(theDialog, 5, itemType, itemHndl, itemRect);         { Get the coordinates of the Eject button}
        with itemRect do
          setRect(eraseArea, itemRect.left - 5, itemRect.top - 11, itemRect.right + 5, itemRect.top);
        eraseRect(eraseArea);
        strWidth := StringWidth(FreeStr);
        left := ((itemRect.right - itemRect.left) div 2) + itemRect.left;
        MoveTo(left - (strWidth div 2), itemRect.top - 2);  { move the pen}
        DrawString(FreeStr);      { show em how much free space they have... }
        TextFont(oldFont);        { set font to the original }
        TextSize(oldSize);        { and the size }
      end;
  end;

  function getDirFileFilter (PB: ParamBlockRec): boolean;
  begin
    getDirFileFilter := true;    { This filter routine filter's out all files so that none are displayed}
  end;

  function getDirDlgHook (item: Integer;
                  theDialog: DialogPtr): Integer;
    procedure AppendDITL (theDialog: DialogPtr);
  { This routine adds the prompt to the main SFGetFile dialog.}
  { It also moves the Cancel button down and adds a 'Select' button.}
      label
        10;
      var
        hDITL: hDITLItem;             { Handle to DITL being appended }
        hItems: hItemList;             { Handle to DLOGΓÇÖs item list }
        btnName: Str255;
        promptHndl: Handle;
        promptLength: longint;
        error: OSerr;
        itemType: integer;
        itemHndl: handle;
        itemRect, SelectRect: rect;
    begin     { AppendDITL }
      BlockMove(POINTER(kApplScratch), @promptHndl, 4);

  { shift the bottom of the window down for the new item}
      SetPort(theDialog);
      with WindowPtr(theDialog)^.portRect do
        SizeWindow(WindowPtr(theDialog), right - left, bottom - top + DITLSizeDiff, TRUE);

  { Move Cancel button down.  It is not enough just to move it with MoveControl.  The Dialog mgr must be }
  { told it has been moved with a call to "SetDItem" }
      GetDItem(theDialog, getCancel, itemType, itemHndl, itemRect);
      SelectRect := itemRect;
      MoveControl(controlHandle(itemHndl), itemRect.left, itemRect.top + 25);
      itemRect.top := itemRect.top + 25;
      itemRect.bottom := itemRect.bottom + 25;
      SetDItem(theDialog, getCancel, itemType, itemHndl, itemRect);

  { Now add the 'Select' button to the DITL}
      btnName := 'Select';
      hDITL := hDITLItem(NewHandle(SizeOf(DITLItem) + length(btnName)));
      if hDITL = nil then
        exit(AppendDITL);
      MoveHHI(handle(hDITL));
      HLock(handle(hDITL));

  { First get the new control}
      SelectRect.top := SelectRect.top + 2;
      SelectRect.bottom := SelectRect.bottom + 2;
      itemHndl := handle(NewControl(theDialog, SelectRect, btnName, true, 0, 0, 1, pushButProc, 0));
      if itemHndl = nil then       { If we didn't get our memory block, don't make any further changes}
        goto 10;

  { Set up a standard button item in the DITL}
      hDITL^^.itmHndl := itemHndl;
      hDITL^^.itmRect := SelectRect;
      hDITL^^.itmType := SignedByte(ctrlItem + btnCtrl);
      hDITL^^.itmData := SignedByte(length(btnName));
      BlockMove(@btnName[1], pointer(ORD4(@hDITL^^.itmData) + 1), length(btnName));

  { Now actually copy the item from our data structure onto the end of the DITL in memory for the DLOG}
      hItems := hItemList(DialogPeek(theDialog)^.items);
      error := PtrAndHand(pointer(hDITL^), Handle(hItems), sizeOf(DITLItem) + 6);
      if error <> noErr then
        sysBeep(10);
      hLock(handle(hItems));
      hItems^^.dlgMaxIndex := hItems^^.dlgMaxIndex + 1;
  { Save the item number for our button}
      blockMove(@hItems^^.dlgMaxIndex, pointer(kApplScratch), 2);
      hUnlock(handle(hItems));

  { Add the stat text item for the prompt}
      HUnlock(Handle(hDITL));
      DisposHandle(Handle(hDITL));

  { Now create the static text item in memory}
      promptLength := GetHandleSize(promptHndl);
      hDITL := hDITLItem(NewHandle(sizeOf(DITLItem) + promptLength));
      if hDITL = nil then
        exit(AppendDITL);         { If we don't have enough memory, abort the changes}

      MoveHHi(handle(hDITL));
      HLock(Handle(hDITL));
      SetRect(itemRect, 12, 191, 246, 223);         { rect for the stat text item }
      hDITL^^.itmHndl := promptHndl;
      hDITL^^.itmRect := itemRect;
      hDITL^^.itmType := SignedByte(statText);
      hDITL^^.itmData := SignedByte(promptLength);
      if promptHndl <> nil then
        begin
    { Copy our prompt onto the end of the DITLrec}
          HLock(handle(promptHndl));
          blockmove(promptHndl^, pointer(ORD4(@hDITL^^.itmData) + 1), promptLength);    { Copy our prompt onto the end of the DITLrec}
          HUnLock(handle(promptHndl));
        end;

  { Now actually copy the item from our data structure onto the end of the DITL in memory for the DLOG}
      hItems := hItemList(DialogPeek(theDialog)^.items);
      error := ptrAndHand(pointer(hDITL^), Handle(hItems), sizeOf(DITLItem) + promptLength);
      hItems^^.dlgMaxIndex := hItems^^.dlgMaxIndex + 1;
10:
      HUnlock(Handle(hDITL));
      DisposHandle(Handle(hDITL));
    end;         { AppendDITL }

    var
      SelectItem: integer;
  begin
    case item of
      -1:
    { Called just before the dialog is shown.  We add our own items now.}
        AppendDITL(theDialog);
      otherwise
        begin    { This is the important one.  The item code for our 'Select' button is in SelectItem.}
    { When it is clicked, we type the event back to a 1 so that standard file will exit.}
    { The highlighted directory ID is put into reply.fType.  reply.vRefNum is filled properly.}
    { We stored the item number - 1 in ApplScratch, remember?!?}
          SelectItem := integerPtr(kApplScratch)^ + 1;
          if item = SelectItem then
            item := 1;
        end;
    end;     { Case}

    getDirDlgHook := item;     { Return the item code back to Standard file}
  end;

  function getDirDlgFilter (theDialog: DialogPtr;
                  var theEvent: eventRecord;
                  var itemHit: integer): boolean;
  { Here we handle the different events that occur in the dialog.  Mainly it is needed to draw the}
  { free space string and to handle enabling/disabling our 'Select' button}
    var
      itemType: integer;
      itemRect: rect;
      trackResult: integer;
      mouseLoc: point;
      cntrlHndl, itemHndl: Controlhandle;
      oldPenState: PenState;    { current pen settings }
  begin
    getDirDlgFilter := false;  { We only use the updateEvt and so pass everything on to the std. filter}
    case theEvent.what of
      updateEvt:
        begin
    { mark the OPEN button as default by drawing a round rect around it }
          GetPenState(oldPenState);    { remember the current pen settings }
          GetDItem(theDialog, getOpen, itemType, handle(itemHndl), itemRect);
          InsetRect(itemRect, -4, -4);
          Pensize(3, 3);
          FrameRoundRect(itemRect, 16, 16);
          SetPenState(oldPenState);
    { While we are diddling around, we might as well draw the amount of free space }
          drawFreeSpace(theDialog);
    { Disable the "Select" button when we are not highlighting any directories}
          GetDItem(theDialog, integerPtr(kApplScratch)^ + 1, itemType, handle(cntrlHndl), itemRect);
          GetDItem(theDialog, getOpen, itemType, handle(itemHndl), itemRect);
          if itemHndl^^.contrlHilite = 255 then
            HiliteControl(cntrlHndl, 255)       { If the Open button is enabled, then enable the Select button}
          else
            HiliteControl(cntrlHndl, 0);       { Otherwise disable the Select button}
        end;
    end;  {case}
  end;  {myDlgFilter}

  procedure SFGetDirectory (pt: point;
                  Prompt: str255;
                  var reply: SFReply);
  { The main routine!}
    var
      typeList: SFTypeList;
      promptHndl: handle;
      errorCode: OSErr;
      savedApplScratch: LongInt;
      oldPort: GrafPtr;
  begin
  { First we need to make sure the prompt is of even length}
    if prompt = '' then
      prompt := 'Hilite a directory and click "Select"';

    if length(prompt) > 240 then
      prompt := copy(prompt, 1, 240)
    else if odd(length(prompt)) then
      prompt := concat(prompt, ' ');

  { Now we need to save the handle to the prompt where our Dialog Hook routine can find it}
    errorCode := ptrToHand(@prompt[1], promptHndl, length(prompt));
    BlockMove(POINTER(kApplScratch), @savedApplScratch, 4);      { save the appl scratch }
    BlockMove(@promptHndl, POINTER(kApplScratch), 4);          { shove our prompt in }

    typeList[0] := '????';

    GetPort(oldPort);  { Save anything that we might change}

    SFPGetFile(pt, '', @getDirFileFilter, 1, TypeList, @getDirDLGHook, reply, getDlgID, @getDirDlgFilter);

    SetPort(oldPort);  { and then restore it}

    BlockMove(@savedApplScratch, POINTER(kApplScratch), 4);    { restore the contents of ApplScratch!!!!! }
  end;

  procedure FolderName (paramPtr: XCMDPtr);
    const
      DITLSizeDiff = 30;      { Room needed for the prompt}
    var
      reply: SFReply;
      pathName: str255;
      prompt: str255;
      dlogHndl: DialogTHndl;
      tempRect: rect;
      thePt: point;
      err: OSErr;
  begin
  { First check to see if the user requested syntax or copyright information}
  { If they did, we exit the XFCN.  The subroutine takes care of returning the proper string}
    if askedForHelp(paramPtr, 'FolderPath(<promptString>)', 'v1.1, ©1989, 1990 Apple Computer, Inc. by Anup Murarka & Eric Carlson') then
      exit(FolderName);

  { Parse the prompt out of the parameter list}
    if paramPtr^.paramCount > 0 then
      ZeroToPas(paramPtr, paramPtr^.params[1]^, prompt)
    else
      prompt := '';

  { do the calculations to center it in the HC window }
    dlogHndl := DialogTHndl(GetResource('DLOG', getDlgID));
    if dlogHndl <> nil then
      with dlogHndl^^.boundsRect do
        SetRect(tempRect, left, top, right, bottom + DITLSizeDiff)
    else
      SetRect(tempRect, 0, 0, 200, 348);
    thePt := CenterInHCWindow(paramPtr, tempRect);

    SFGetDirectory(thePt, Prompt, reply);        { All of the real work is done by this routine in customSF.p}
    if reply.good then                      { If a directory was selected, return the pathname}
      begin
        err := PathNameFromDirID(longint(reply.fType), reply.vRefNum, pathName);
        if err = noErr then
          paramPtr^.returnValue := PasToZero(paramPtr, pathName);
      end;
  end;
end.